home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / emacs.lha / emacs-19.16 / lisp / mailpost.el < prev    next >
Lisp/Scheme  |  1992-09-21  |  3KB  |  104 lines
  1. ;;; mailpost.el --- RMAIL coupler to /usr/uci/post mailer
  2.  
  3. ;; This is in the public domain
  4. ;; since Delp distributed it without a copyright notice in 1986.
  5.  
  6. ;; Author: Gary Delp <delp@huey.Udel.Edu>
  7. ;; Maintainer: FSF
  8. ;; Created: 13 Jan 1986
  9. ;; Keywords: mail
  10.  
  11. ;;; Commentary:
  12.  
  13. ;; Yet another mail interface.  this for the rmail system to provide
  14. ;;  the missing sendmail interface on systems without /usr/lib/sendmail,
  15. ;;   but with /usr/uci/post.
  16.  
  17. ;;; Code:
  18.  
  19. (require 'mailalias)
  20. (require 'sendmail)
  21.  
  22. ;; (setq send-mail-function 'post-mail-send-it)
  23.  
  24. (defun post-mail-send-it ()
  25.   "The MH -post interface for `rmail-mail' to call.
  26. To use it, include \"(setq send-mail-function 'post-mail-send-it)\" in
  27. site-init."
  28.   (let ((errbuf (if mail-interactive
  29.             (generate-new-buffer " post-mail errors")
  30.           0))
  31.     (temfile "/tmp/,rpost")
  32.     (tembuf (generate-new-buffer " post-mail temp"))
  33.     (case-fold-search nil)
  34.     delimline
  35.     (mailbuf (current-buffer)))
  36.     (unwind-protect
  37.     (save-excursion
  38.       (set-buffer tembuf)
  39.       (erase-buffer)
  40.       (insert-buffer-substring mailbuf)
  41.       (goto-char (point-max))
  42.       ;; require one newline at the end.
  43.       (or (= (preceding-char) ?\n)
  44.           (insert ?\n))
  45.       ;; Change header-delimiter to be what post-mail expects.
  46.       (goto-char (point-min))
  47.       (search-forward (concat "\n" mail-header-separator "\n"))
  48.       (replace-match "\n\n")
  49.       (backward-char 1)
  50.       (setq delimline (point-marker))
  51.       (if mail-aliases
  52.           (expand-mail-aliases (point-min) delimline))
  53.       (goto-char (point-min))
  54.       ;; ignore any blank lines in the header
  55.       (while (and (re-search-forward "\n\n\n*" delimline t)
  56.               (< (point) delimline))
  57.         (replace-match "\n"))
  58.       ;; Find and handle any FCC fields.
  59.       (let ((case-fold-search t))
  60.         (goto-char (point-min))
  61.         (if (re-search-forward "^FCC:" delimline t)
  62.         (mail-do-fcc delimline))
  63.         ;; If there is a From and no Sender, put it a Sender.
  64.         (goto-char (point-min))
  65.         (and (re-search-forward "^From:"  delimline t)
  66.          (not (save-excursion
  67.             (goto-char (point-min))
  68.             (re-search-forward "^Sender:" delimline t)))
  69.          (progn
  70.            (forward-line 1)
  71.            (insert "Sender: " (user-login-name) "\n")))
  72.         ;; don't send out a blank subject line
  73.         (goto-char (point-min))
  74.         (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
  75.         (replace-match ""))
  76.         (if mail-interactive
  77.         (save-excursion
  78.           (set-buffer errbuf)
  79.           (erase-buffer))))
  80.       (write-file (setq temfile (make-temp-name temfile)))
  81.       (set-file-modes temfile 384)
  82.       (apply 'call-process
  83.          (append (list (if (boundp 'post-mail-program)
  84.                    post-mail-program
  85.                  "/usr/uci/lib/mh/post")
  86.                    nil errbuf nil
  87.                    "-nofilter" "-msgid")
  88.              (if mail-interactive '("-watch") '("-nowatch"))
  89.              (list temfile)))
  90.       (if mail-interactive
  91.           (save-excursion
  92.         (set-buffer errbuf)
  93.         (goto-char (point-min))
  94.         (while (re-search-forward "\n\n* *" nil t)
  95.           (replace-match "; "))
  96.         (if (not (zerop (buffer-size)))
  97.             (error "Sending...failed to %s"
  98.                (buffer-substring (point-min) (point-max)))))))
  99.       (kill-buffer tembuf)
  100.       (if (bufferp errbuf)
  101.       (switch-to-buffer errbuf)))))
  102.  
  103. ;;; mailpost.el ends here
  104.